home *** CD-ROM | disk | FTP | other *** search
/ NeXT Education Software Sampler 1992 Fall / NeXT Education Software Sampler 1992 Fall.iso / Programming / Source / winterp-1.13 / src-server / wc_Scale.c < prev    next >
Encoding:
C/C++ Source or Header  |  1991-10-04  |  8.2 KB  |  223 lines
  1. /* -*-C-*-
  2. ********************************************************************************
  3. *
  4. * File:         wc_Scale.c
  5. * RCS:          $Header: wc_Scale.c,v 1.3 91/03/14 03:15:06 mayer Exp $
  6. * Description:  XM_SCALE_WIDGET_CLASS
  7. * Author:       Niels Mayer, HPLabs
  8. * Created:      Sat Oct 28 04:32:59 1989
  9. * Modified:     Thu Oct  3 23:40:58 1991 (Niels Mayer) mayer@hplnpm
  10. * Language:     C
  11. * Package:      N/A
  12. * Status:       X11r5 contrib tape release
  13. *
  14. * WINTERP Copyright 1989, 1990, 1991 Hewlett-Packard Company (by Niels Mayer).
  15. * XLISP version 2.1, Copyright (c) 1989, by David Betz.
  16. *
  17. * Permission to use, copy, modify, distribute, and sell this software and its
  18. * documentation for any purpose is hereby granted without fee, provided that
  19. * the above copyright notice appear in all copies and that both that
  20. * copyright notice and this permission notice appear in supporting
  21. * documentation, and that the name of Hewlett-Packard and David Betz not be
  22. * used in advertising or publicity pertaining to distribution of the software
  23. * without specific, written prior permission.  Hewlett-Packard and David Betz
  24. * make no representations about the suitability of this software for any
  25. * purpose. It is provided "as is" without express or implied warranty.
  26. *
  27. * HEWLETT-PACKARD AND DAVID BETZ DISCLAIM ALL WARRANTIES WITH REGARD TO THIS
  28. * SOFTWARE, INCLUDING ALL IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS,
  29. * IN NO EVENT SHALL HEWLETT-PACKARD NOR DAVID BETZ BE LIABLE FOR ANY SPECIAL,
  30. * INDIRECT OR CONSEQUENTIAL DAMAGES OR ANY DAMAGES WHATSOEVER RESULTING FROM
  31. * LOSS OF USE, DATA OR PROFITS, WHETHER IN AN ACTION OF CONTRACT, NEGLIGENCE
  32. * OR OTHER TORTIOUS ACTION, ARISING OUT OF OR IN CONNECTION WITH THE USE OR
  33. * PERFORMANCE OF THIS SOFTWARE.
  34. *
  35. * See ./winterp/COPYRIGHT for information on contacting the authors.
  36. * 
  37. * Please send modifications, improvements and bugfixes to mayer@hplabs.hp.com
  38. * Post XLISP-specific questions/information to the newsgroup comp.lang.lisp.x
  39. *
  40. ********************************************************************************
  41. */
  42. static char rcs_identity[] = "@(#)$Header: wc_Scale.c,v 1.3 91/03/14 03:15:06 mayer Exp $";
  43.  
  44.  
  45. #include <stdio.h>
  46. #include <Xm/Xm.h>
  47. #include <Xm/Scale.h>
  48. #include "winterp.h"
  49. #include "user_prefs.h"
  50. #include "xlisp/xlisp.h"
  51. #include "w_funtab.h"
  52.  
  53. extern Widget Wcls_Get_WIDGETOBJ_Argument_Returning_Validated_WidgetID(); /* w_classes.c */
  54.  
  55.  
  56. /******************************************************************************
  57.  * typedef struct 
  58.  * {
  59.  *    int reason;
  60.  *    XEvent * event;
  61.  *    int value;
  62.  * } XmScaleCallbackStruct;
  63.  ******************************************************************************/
  64. static void Lexical_Bindings_For_XmScaleCallbackStruct(bindings_list, lexical_env, cd, o_widget)
  65.      LVAL bindings_list;    /* a list of symbols to which values from XmScaleCallbackStruct are bound */
  66.      LVAL lexical_env;        
  67.      XmScaleCallbackStruct* cd;
  68.      LVAL o_widget;        /* XLTYPE_WIDGETOBJ */
  69. {
  70.   extern LVAL s_CALLBACK_WIDGET, s_CALLBACK_REASON, s_CALLBACK_XEVENT, s_CALLBACK_VALUE; /* w_callbacks.c */
  71.   extern LVAL Wcb_Get_Callback_Reason_Symbol();    /* w_callbacks.c */
  72.   register LVAL s_bindname;
  73.  
  74.   for ( ; consp(bindings_list); bindings_list = cdr(bindings_list)) {
  75.  
  76.     s_bindname = car(bindings_list);
  77.  
  78.     if (s_bindname == s_CALLBACK_WIDGET) {
  79.       xlpbind(s_bindname, o_widget, lexical_env);
  80.     }
  81.     else if (s_bindname == s_CALLBACK_REASON) {
  82.       xlpbind(s_bindname, Wcb_Get_Callback_Reason_Symbol(cd->reason), lexical_env);
  83.     }
  84.     else if (s_bindname == s_CALLBACK_XEVENT) {
  85.       xlpbind(s_bindname, (cd->event) ? cv_xevent(cd->event) : NIL, lexical_env);
  86.     }
  87.     else if (s_bindname == s_CALLBACK_VALUE) {
  88.       xlpbind(s_bindname, cvfixnum((FIXTYPE) cd->value), lexical_env);
  89.     }
  90.     else {
  91.       extern char temptext[];    /* from winterp.c */
  92.       sprintf(temptext,
  93.           "Unknown binding name in XmScaleCallbackStruct callback evaluator. Valid symbols are [%s %s %s %s].",
  94.           (char*) getstring(getpname(s_CALLBACK_WIDGET)),
  95.           (char*) getstring(getpname(s_CALLBACK_REASON)),
  96.           (char*) getstring(getpname(s_CALLBACK_XEVENT)),
  97.           (char*) getstring(getpname(s_CALLBACK_VALUE)));
  98.       xlerror(temptext, s_bindname);
  99.     }
  100.   }
  101. }
  102.  
  103.  
  104. /******************************************************************************
  105.  * This is called indirectly via XtAddCallback() for callbacks returning
  106.  * an XmScaleCallbackStruct as call_data.
  107.  ******************************************************************************/
  108. static void XmScaleCallbackStruct_Callbackproc(widget, client_data, call_data)
  109.      Widget    widget;
  110.      XtPointer client_data;
  111.      XtPointer call_data;
  112. {
  113.   extern void Wcb_Meta_Callbackproc();    /* w_callbacks.c */
  114.  
  115.   Wcb_Meta_Callbackproc(client_data, call_data,
  116.             Lexical_Bindings_For_XmScaleCallbackStruct,
  117.             NULL);
  118. }
  119.  
  120. /******************************************************************************
  121.  * Same as WIDGET_CLASS's :add_callback method except that this understands
  122.  * how to get values from the XmScaleCallbackStruct.
  123.  * Specifying one or more of the following symbols in the callback bindings 
  124.  * list will bind that symbol's value in the lexical environment of the callback:
  125.  * CALLBACK_WIDGET
  126.  * CALLBACK_REASON
  127.  * CALLBACK_XEVENT
  128.  * CALLBACK_VALUE
  129.  ******************************************************************************/
  130. LVAL Xm_Scale_Widget_Class_Method_ADD_CALLBACK()
  131. {
  132.   extern LVAL Wcb_Meta_Method_Add_Callback(); /* w_callbacks.c */
  133.  
  134.   return (Wcb_Meta_Method_Add_Callback(XmScaleCallbackStruct_Callbackproc, FALSE));
  135. }
  136.  
  137.  
  138. /******************************************************************************
  139.  * Same as WIDGET_CLASS's :set_callback method except that this understands
  140.  * how to get values from the XmScaleCallbackStruct.
  141.  * Specifying one or more of the following symbols in the callback bindings 
  142.  * list will bind that symbol's value in the lexical environment of the callback:
  143.  * CALLBACK_WIDGET
  144.  * CALLBACK_REASON
  145.  * CALLBACK_XEVENT
  146.  * CALLBACK_VALUE
  147.  ******************************************************************************/
  148. LVAL Xm_Scale_Widget_Class_Method_SET_CALLBACK()
  149. {
  150.   extern LVAL Wcb_Meta_Method_Add_Callback(); /* w_callbacks.c */
  151.  
  152.   return (Wcb_Meta_Method_Add_Callback(XmScaleCallbackStruct_Callbackproc, TRUE));
  153. }
  154.  
  155. /******************************************************************************
  156.  * (send <scale_widget> :SET_VALUE <value>) --> rets <scale_widget>
  157.  * 
  158.  * void XmScaleSetValue (w, value)
  159.  * Widget w;
  160.  * int    value;
  161.  ******************************************************************************/
  162. LVAL Xm_Scale_Widget_Class_Method_SET_VALUE()
  163. {
  164.   LVAL self;
  165.   Widget widget_id;
  166.   int value;
  167.  
  168.   widget_id = Wcls_Get_WIDGETOBJ_Argument_Returning_Validated_WidgetID(&self);
  169.   value = (int) getfixnum(xlgafixnum());
  170.   xllastarg();
  171.  
  172.   XmScaleSetValue(widget_id, value);
  173.  
  174.   return (self);
  175. }
  176.  
  177. /******************************************************************************
  178.  * (send <scale_widget> :GET_VALUE) --> returns slider value as a FIXNUM
  179.  * 
  180.  * void XmScaleGetValue (w, value)
  181.  * Widget w;
  182.  * int * value;
  183.  ******************************************************************************/
  184. LVAL Xm_Scale_Widget_Class_Method_GET_VALUE()
  185. {
  186.   LVAL self;
  187.   Widget widget_id;
  188.   int value;
  189.  
  190.   widget_id = Wcls_Get_WIDGETOBJ_Argument_Returning_Validated_WidgetID(&self);
  191.   xllastarg();
  192.  
  193.   XmScaleGetValue(widget_id, &value);
  194.  
  195.   return (cvfixnum((FIXTYPE) value));
  196. }
  197.  
  198. /******************************************************************************
  199.  *
  200.  ******************************************************************************/
  201. Wc_Scale_Init()
  202. {
  203.   LVAL o_XM_SCALE_WIDGET_CLASS;
  204.   extern LVAL Wcls_Create_Subclass_Of_WIDGET_CLASS(); /* w_classes.c */
  205.   extern      xladdmsg();    /* from xlobj.c */
  206.  
  207.   o_XM_SCALE_WIDGET_CLASS =
  208.     Wcls_Create_Subclass_Of_WIDGET_CLASS("XM_SCALE_WIDGET_CLASS",
  209.                      xmScaleWidgetClass);
  210.  
  211.   xladdmsg(o_XM_SCALE_WIDGET_CLASS, ":ADD_CALLBACK",
  212.            FTAB_Xm_Scale_Widget_Class_Method_ADD_CALLBACK);
  213.  
  214.   xladdmsg(o_XM_SCALE_WIDGET_CLASS, ":SET_CALLBACK",
  215.            FTAB_Xm_Scale_Widget_Class_Method_SET_CALLBACK);
  216.  
  217.   xladdmsg(o_XM_SCALE_WIDGET_CLASS, ":SET_VALUE",
  218.        FTAB_Xm_Scale_Widget_Class_Method_SET_VALUE);
  219.  
  220.   xladdmsg(o_XM_SCALE_WIDGET_CLASS, ":GET_VALUE",
  221.        FTAB_Xm_Scale_Widget_Class_Method_GET_VALUE);
  222. }
  223.